VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsGetCancelDirData"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit

Public Function GetCancelDirective(ByRef strFailReason As String, ByRef nNumCancelReq As String, ByVal strServerName As String) As Boolean

Dim adoConn As ADODB.Connection
Dim RSCancelReq As ADODB.Recordset
Dim adoComm As ADODB.Command
Dim iCounter As Integer
Dim strDllErrMsg As String

ServerName = strServerName

On Error GoTo PROC_ERROR


Set adoConn = New ADODB.Connection
With adoConn
    .ConnectionString = GetConnectionString() 'Johann (20090625): Centralised code for connection string added
    .Open
End With

'Get response data
Set RSCancelReq = New ADODB.Recordset
With RSCancelReq
    .CursorLocation = adUseClient
    .CursorType = adOpenStatic
End With

Set adoComm = New ADODB.Command
With adoComm
    .CommandText = "Select * from dir_response where (REQUEST_STATUS = '08') and req_seq_num in (select req_seq_num from dir_interface_index where sars_response_yn = 'N')"
    .CommandType = adCmdText
    Set .ActiveConnection = adoConn
End With
    
Set RSCancelReq = adoComm.Execute
nNumCancelReq = RSCancelReq.RecordCount

'Validate recordset exists
Dim dllRecordsetExist As clsIsRecordsetEmpty
Set dllRecordsetExist = New clsIsRecordsetEmpty
Dim blResponseRSEmpty As Boolean
blResponseRSEmpty = dllRecordsetExist.IsEmpty(RSCancelReq)

If blResponseRSEmpty = True Then
        GetCancelDirective = False
        strFailReason = "There were no cancelled responses to send to MQ"
        nNumCancelReq = 0
        Exit Function
Else
    Do While Not RSCancelReq.EOF

    'Write XML File
    Dim dllCreateXMLCancel As clsCreateXMLDirCancel
    Set dllCreateXMLCancel = New clsCreateXMLDirCancel
    Dim blCreateXMLCancel As Boolean
    Dim strXmlVersDtdHeader As String
    Dim strXMLResponseCancel As String
    
    nReqSeqNum = RSCancelReq("req_seq_num").Value
    'strXmlVersDtdHeader = dllCreateXMLCancel.CreateXmlVersionDtdHeader()
    strXMLResponseCancel = dllCreateXMLCancel.XMLCreateCancelDirective(strDllErrMsg)
    
    If strXMLResponseCancel <> "" Then
        GetCancelDirective = True
    Else
        GetCancelDirective = False
        Exit Function
    End If
    
    
    'Update Index table / Update XML table
    Dim dllSendIntIndex As clsSendIntIndex
    Set dllSendIntIndex = New clsSendIntIndex
    
    Dim lngNewInterfaceNo As String
    Dim strNewMsgId As String
    
    If strXMLResponseCancel <> "" Then
        If dllSendIntIndex.InsertIntoInterfaceIndex(lngNewInterfaceNo, nNewMessageID) Then
            If dllSendIntIndex.InsertIntoInterfaceXml(lngNewInterfaceNo, nNewMessageID, strXmlVersDtdHeader, strXMLResponseCancel) Then
            'Added this line Fikile 2007/06/20
                If dllSendIntIndex.UpdateInterfaceIndex(nReqSeqNum) Then
                    GetCancelDirective = True
                Else
                    strFailReason = "InsertIntoInterfaceXml failed"
                    GetCancelDirective = False
                End If
            Else
                strFailReason = "InsertIntoInterfaceXml failed"
                GetCancelDirective = False
            End If
        Else
            strFailReason = "InsertIntoInterfaceIndex failed"
            GetCancelDirective = False
            Exit Function
        End If
    Else
        strFailReason = "InsertIntoInterfaceIndex failed"
        GetCancelDirective = False
    End If
    
    If GetCancelDirective = True Then
        'Display Progress
        iCounter = iCounter + 1
        Form1.List1.AddItem CStr(iCounter) & " - " & "Extracting cancel responses - seq number: " & nReqSeqNum
        Form1.List1.ListIndex = iCounter - 1
        Form1.List1.Refresh
        
        RSCancelReq.MoveNext
    Else
        GetCancelDirective = False
        Exit Function
    End If
    
    Loop
    
    'It was returning no value, so we added this line: Fikile 2007/06/20
    nNumCancelReq = iCounter
    
End If


'clean up
RSCancelReq.Close
Set RSCancelReq = Nothing
adoConn.Close
Set adoComm = Nothing
Form1.Hide
PROC_EXIT:
  Exit Function

PROC_ERROR:
    GetCancelDirective = False
    Err.Raise Err.Number, _
              "clsGetCancelDirData/GetCancelDirective", _
              Err.Description
              
Resume PROC_EXIT


End Function



